home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 050 / disk_425.arc / TRAP2.PAS < prev    next >
Pascal/Delphi Source File  |  1985-04-03  |  1KB  |  56 lines
  1. program trap2;        { -> 266 }
  2. { integration by the trapezoidal rule }
  3.  
  4. const    tol        = 1.0E-4;
  5. var    sum,upper,lower    : real;
  6.  
  7. external procedure cls;
  8.  
  9. function fx(x: real): real;
  10. { find f(x)=1/x }
  11. { watch out for x=0 ! }
  12. begin
  13.   fx:=1.0/x
  14. end;
  15.  
  16. procedure trapez(lower,upper,tol: real;
  17.         var sum        : real);
  18.  
  19. { numerical integration by the trapezoid method }
  20. { function is FX, limits are LOWER and UPPER }
  21. { with number of regions equal to PIECES }
  22. { fixed partition is DELTA_X, answer is SUM }
  23.  
  24. var    pieces,i            : integer;
  25.     x,delta_x,end_sum,mid_sum,sum1    : real;
  26. begin
  27.   pieces:=1;
  28.   delta_x:=(upper-lower)/pieces;
  29.   end_sum:=fx(lower)+fx(upper);
  30.   sum:=end_sum*delta_x/2.0;
  31.   writeln('    1',sum);
  32.   mid_sum:=0.0;
  33.   repeat
  34.     pieces:=pieces*2;
  35.     sum1:=sum;
  36.     delta_x:=(upper-lower)/pieces;
  37.     for i:=1 to pieces div 2 do
  38.     begin
  39.       x:=lower+delta_x*(2.0*i-1.0);
  40.       mid_sum:=mid_sum+fx(x)
  41.     end;
  42.   sum:=(end_sum+2.0*mid_sum)*delta_x*0.5;
  43.   writeln(pieces:5,sum)
  44.   until abs(sum-sum1)<=abs(tol*sum)
  45. end;        { TRAPEZ }
  46.  
  47. begin        { main program }
  48.   cls;
  49.   lower:=1.0;
  50.   upper:=9.0;
  51.   writeln;
  52.   trapez(lower,upper,tol,sum);
  53.   writeln;
  54.   writeln(chr(7),'area=',sum)
  55. end.
  56.